home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Tools / Alpha 6.51b13 ƒ / Tcl / Menus / codeWarriorMenu.tcl next >
Text File  |  1996-09-04  |  12KB  |  452 lines
  1. #=== nowrap =====================================================================
  2. #
  3. #             CodeWarrior Interaction
  4. #
  5. # Metrowerks currently has an incomplete appleevent interface. 
  6. # Apple events can be used to direct CodeWarrior to compile
  7. # or add individual files, make the project, etc. However, 
  8. # there is currently no provision to report specific errors
  9. # back to the controller.
  10. #
  11. #================================================================================
  12.  
  13. if {$startingUp} {
  14.     set cwdebugMenu        "•274"
  15.     set cwarriorMenu    "•268"
  16.     addMenu cwarriorMenu
  17.     return
  18. }
  19.  
  20.  
  21. proc cwarriorMenu {} {}
  22.  
  23.  
  24. # called after files saved
  25. lappend savePostHooks codeWarrior_modified
  26.  
  27.  
  28. menu -n "$cwarriorMenu" -p codeWarriorProc {
  29.     "help"
  30.     "/-<UswitchTo"
  31.     {menu -n werksFlags -p werksProc {
  32.         "debugger"
  33.         "switchWhenCompiling"
  34.     }}
  35.     "createFileset"
  36.     {menu -n headers -p cIncludeProc {
  37.         "open"
  38.         "addFolder…"
  39.         "removeFolder…"
  40.         "(-"
  41.     }}
  42.     "(-"
  43.     "addFile"
  44.     "/K<Ucompile"
  45.     "compileFiles"
  46.     "checkSyntax"
  47.     "precompile…"
  48.     "(-"
  49.     "openHeader"
  50.     "(-"
  51.     "/U<Uupdate"
  52.     "/M<Umake"
  53.     "(-"
  54.     "/D<UgotoDebugger"
  55.     "/B<UsetBreakpoint"
  56.     "clearBreakpoint"
  57.     "/J<UshowSource"
  58.     "(-"
  59.     "/N<UnextError"
  60.     "/R<Urun"
  61. }
  62.  
  63. if {![info exists cwdebugger]}     {set cwdebugger     0}
  64. if {![info exists cwswitchWhenCompiling]}     {set cwswitchWhenCompiling 1}
  65. markMenuItem werksFlags debugger $cwdebugger
  66. markMenuItem werksFlags switchWhenCompiling $cwswitchWhenCompiling
  67.  
  68. proc cwhelp {} {
  69.     global HOME
  70.     edit -r "$HOME:Help:CodeWarrior"
  71. }
  72.     
  73. proc werksProc {menu item} {
  74.     global cw$item modifiedVars
  75.     
  76.     set cw$item [expr -1 * ([set cw$item] - 1)]
  77.     markMenuItem werksFlags $item [set cw$item]
  78.     lappend modifiedVars cw$item
  79. }
  80.  
  81.  
  82.  
  83. set CWCLASS        MMPR
  84. set CDCLASS        MWDB
  85.  
  86.  
  87. proc cwnextError {} {
  88.     nextMatch "*Compiler Errors*"
  89. }
  90.  
  91. proc dispErr {{win "* Compiler Errors *"}} {
  92.     if {[string length $win]} {
  93.         set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  94.         if {[regexp {(Line.*)∞} $text dummy sub]} {
  95.             message "$sub"
  96.         }
  97.     }
  98. }
  99.         
  100.  
  101. proc codeWarriorProc {menu item} {
  102.     cw$item
  103. }
  104.     
  105. proc cwswitchTo {} {
  106.     global CODEWarrior
  107.     checkCw
  108.     switchTo $CODEWarrior
  109. }
  110.  
  111. proc cwmake {} {killCwErrors; cwDo Make}
  112. proc cwupdate {} {cwDo UpdP}
  113.  
  114. proc cwDo {param} {
  115.     global CODEWarrior CWCLASS ALPHA
  116.     checkCw
  117.     switchTo $CODEWarrior
  118.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(«01»)"]]]} {
  119.         warriorErrors $res
  120.     }
  121. }
  122.  
  123. proc cwrun {} {
  124.     global CODEWarrior CWCLASS ALPHA cwdebugger
  125.     checkCw
  126.     killCwErrors
  127.     set bug $cwdebugger
  128.     switchTo $CODEWarrior
  129.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(«01»)" DeBg $bug]]]} {
  130.         warriorErrors $res
  131.     }
  132. }
  133.  
  134.  
  135. proc cwprecompile {} {
  136.     global CODEWarrior CWCLASS res
  137.     checkCw
  138.     set fname [car [winNames -f]]
  139.     set targ [putfile "Precompile target:"]
  140.     switchTo $CODEWarrior
  141.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(«01»)" Targ [makeAlis $targ]]]] > 40} {
  142.         warriorErrors $res
  143.     } else {
  144.         if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  145.             message "Error number: $errno"
  146.         }
  147.     }
  148. }
  149.  
  150.  
  151. proc cwaddFile {} {
  152.     global CODEWarrior CWCLASS
  153.     checkCw
  154.     switchTo $CODEWarrior
  155.     set fname [car [winNames -f]]
  156.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  157. }
  158.  
  159. proc cwcheckSyntax {} {
  160.     global CODEWarrior CWCLASS res
  161.     checkCw
  162. #    switchTo $CODEWarrior
  163.     set fname [car [winNames -f]]
  164.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}] "Errs" "bool(«01»)"]]] > 40} {
  165.         warriorErrors $res
  166.     }
  167. }
  168.  
  169.  
  170. proc killCwErrors {} {
  171.     set wins [winNames]
  172.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  173.         set name [lindex $wins $res]
  174.         bringToFront $name
  175.         killWindow
  176.     }
  177. }    
  178.  
  179.  
  180. proc cwcompile {} {
  181.     global CODEWarrior CWCLASS res ALPHA cwswitchWhenCompiling
  182.     save
  183.     checkCw
  184.     set fname [car [winNames -f]]
  185.     killCwErrors
  186.     if {$cwswitchWhenCompiling} {
  187.         switchTo $CODEWarrior
  188.     }
  189.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(«01»)"]]] > 40} {
  190.         warriorErrors $res
  191.     }
  192.     switchTo $ALPHA
  193. }
  194.  
  195.  
  196. proc cwcompileFiles {} {
  197.     global CODEWarrior CWCLASS res ALPHA winModes
  198.     saveAll
  199.     checkCw
  200.     set files {}
  201.     set wins [winNames -f]
  202.     set md $winModes([lindex $wins 0])
  203.     foreach w $wins {
  204.         if {$md == $winModes($w)} {
  205.             lappend files $w
  206.         }
  207.     }
  208.     killCwErrors
  209.     switchTo $CODEWarrior
  210.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [eval makeAlises $files] "Errs" "bool(«01»)"]]] > 40} {
  211.         warriorErrors $res
  212.     }
  213.     switchTo $ALPHA
  214. }
  215.  
  216.  
  217. proc cwGetFiles {} {
  218.     global CODEWarrior CWCLASS
  219.     checkCw
  220.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  221.     regexp {\[(.*)\]} $res dummy segs
  222.     regsub -all {, Seg} $segs {•} segs
  223.     set ind 1
  224.     foreach seg [split $segs {•}] {
  225.         regexp {NumF:([0-9]+)} $seg dummy num
  226.         
  227.         while {$num > 0} {
  228.             set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  229.             if {[regexp {FTxt} $res]} {
  230.                 regexp {«(.*)»} $res dummy spec
  231.                 set f [specToPathName $spec]
  232.                 message $f
  233.                 lappend files $f
  234.             }
  235.             incr num -1
  236.         }
  237.         incr ind
  238.     }
  239.     return $files
  240. }
  241.  
  242. proc cwcreateFileset {} {
  243.     createWarriorFileset
  244.     rebuildAllFilesets
  245. }
  246.  
  247.  
  248. proc createWarriorFileset {} {
  249.     global gfileSets gfileSetsType
  250.     
  251.     set name [prompt "Fileset name? " "CodeWarrior"]
  252.     set gfileSets($name) [lsort -command sortByTail [cwGetFiles]]
  253.     set gfileSetsType($name) codewarrior
  254.     addArrDef gfileSetsType $name codewarrior
  255.  
  256.     if {[askyesno "Save project fileset?"] == "yes"} {
  257.         addArrDef gfileSets $name  $gfileSets($name)
  258.     }
  259.     return $name
  260. }
  261.  
  262.  
  263. # the error reply from CodeWarrior looks like this
  264. # [ErrM{ErrT:ErCW, ErrS:“function declaration hides inherited virtual function”, file:fss («FFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000»), ErrL:64}, ...]
  265. #
  266. # ErrT is the error type parameter
  267. #     ErCW indicates a warning
  268. #     ErCE indicates an error
  269. # Improvements by jdunning@cs.Princeton.EDU (John Dunning)
  270. proc warriorErrors {res} {    
  271.     global winModes tileLeft tileTop tileWidth errorHeight
  272.  
  273.     if {[regexp {\[.*\]} $res res]} {
  274.             # trim off the outside brackets
  275.         set res [string trim $res {[]}]
  276.         
  277.             # replace all the returns in the error list with spaces.  this is 
  278.             # necessary because CW 7.0 can return multi-line error messages,
  279.             # which aren't processed correctly by this function.
  280.         regsub -all "\r" $res " " res
  281.         
  282.             # delete the first ErrM, and replace the remaining ones (and the preceeding commas)
  283.             # with returns
  284.         regsub {ErrM} $res "" res
  285.         regsub -all {, ErrM} $res "\r" res
  286.         
  287.         set text ""
  288.         set errors 0
  289.         set warnings 0
  290.         set messages 0
  291.         set link 0
  292.         
  293.             # split the string into separate lines, one error per line.  only process
  294.             # process the first 101 errors
  295.         foreach err [lrange [split $res "\r"] 0 100] {
  296.                 # the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
  297.                 # error and whether it's an error (E) or a warning (W).  stick the rest of
  298.                 # the error message back into err.
  299.             if {[regexp {ErrT:Er(.)(.),[ \t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
  300.                 if {$errorOrWarning == "E"} {
  301.                         # mark actual errors with a bullet
  302.                     append text " • "
  303.                     incr errors
  304.                 } else {
  305.                         # mark warnings with a delta
  306.                     append text " Δ "
  307.                     incr warnings
  308.                 }
  309.                 
  310.                 if {$compileOrLink == "C"} {
  311.                         # we have a compile error, so strip out the error message, the filespec
  312.                         # and the line number
  313.                     if {[regexp {ErrS:“(.*)”.*«(.*)».*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
  314.                             # conver the filespec that was returned in the apple event into a pathname
  315.                             # so we can display it
  316.                         set pathName [specToPathName $fileSpec]
  317.                     
  318.                             # append the file name (the tail of the pathname), the line number,
  319.                             # the error string, lots of tabs, and then the full pathname
  320.                         append text "\"[file tail $pathName]\"\t; Line $lineNumber: $errorString\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$pathName\r"
  321.                     }
  322.                 } else {
  323.                         # we got a link error
  324.                     set link 1
  325.                     
  326.                         # just strip out the error message.  the file the error occurs in doesn't 
  327.                         # seem to get included in the event
  328.                     if {[regexp {ErrS:“(.*)”} $err unused errorString]} {
  329.                             # append the error message
  330.                         append text "$errorString\r"
  331.                     }
  332.                 }
  333.             } elseif {[regexp {“([^:]*): (.*)”} $err unused fileName message]} {
  334.                     # we got some sort of message, so strip out the associated file name and 
  335.                     # the message.  I'm not sure if CodeWarrior still returns anything of this form.
  336.                 append text "\"$fileName\" ; $message\r"
  337.                 incr messages
  338.             }
  339.         }
  340.  
  341.         set wins [winNames]
  342.         if {$errors == 0 && $warnings == 0 && $messages == 0} {
  343.             global killCompilerErrors
  344.             set killCompilerErrors 1
  345.             return
  346.         }
  347.         
  348.         new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight
  349.         changeMode [set winModes([lindex [winNames] 0]) Brws]
  350.  
  351.         if {$link} {
  352.             insertText "(Link: $errors errors, $warnings warnings, $messages messages)\r-----\r$text"
  353.         } else {
  354.             insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)\r-----\r$text"
  355.         }
  356.  
  357.         display 0
  358.         goto 0
  359.         downBrowse
  360.         setWinInfo dirty 0
  361.         setWinInfo read-only 1
  362.         gotoMatch
  363.     }
  364. }
  365.  
  366.  
  367.  
  368. proc codeWarrior_modified fname { 
  369.     global CWCompSig CWCLASS mode
  370.     
  371.     if {($mode == "C") || ($mode == "C++")} {
  372.         foreach p [processes] {
  373.             if {[lindex $p 1] == $CWCompSig} {
  374.                 set res [AEBuild -t 500000 [lindex $p 0] $CWCLASS "Toch" "----" [makeAlis $fname]]
  375.                 return
  376.             }
  377.         }
  378.     }
  379. }
  380.  
  381.  
  382. proc cwTouch {} {
  383.     global CODEWarrior CWCLASS
  384.     checkCw
  385.     switchTo $CODEWarrior
  386.     set fname [car [winNames -f]]
  387.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  388. }
  389.     
  390. proc checkCw {} {
  391.     global CODEWarrior modifiedVars CWCompSig 
  392.     if {![info exists CWCompSig]} {set CWCompSig CWIE}
  393.     
  394.     if {[catch {launchBackApplSigs {CWIE MMCC MPCC} CWCompSig} name]} {
  395.         getApplSig "Please locate CodeWarrior compiler" CWCompSig
  396.     }
  397.     set CODEWarrior [file tail [launchBackAppl $CWCompSig]]
  398. }
  399.  
  400. proc checkCwDebug {} {
  401.     global CODEDEBUGGER CWDbgSig modifiedVars
  402.     if {[catch {launchBackApplSigs {MPDB MWDB} CWDbgSig} name]} {
  403.         getApplSig "Please locate CodeWarrior debugger" CWDbgSig
  404.     }
  405.     set CODEDEBUGGER [file tail [launchBackAppl $CWDbgSig]]
  406. }
  407.  
  408. proc cwgotoDebugger {} {
  409.     global CODEDEBUGGER
  410.     checkCwDebug
  411.     switchTo $CODEDEBUGGER
  412. }
  413.  
  414. proc cwsetBreakpoint {} {
  415.     global CODEDEBUGGER CDCLASS res
  416.     checkCwDebug
  417.     switchTo $CODEDEBUGGER
  418.     set fname [car [winNames -f]]
  419.     set ln [lindex [posToRowCol [getPos]] 0]
  420.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  421. }
  422.  
  423. proc cwclearBreakpoint {} {
  424.     global CODEDEBUGGER CDCLASS res
  425.     checkCwDebug
  426.     switchTo $CODEDEBUGGER
  427.     set fname [car [winNames -f]]
  428.     set ln [lindex [posToRowCol [getPos]] 0]
  429.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  430. }
  431.  
  432.  
  433. proc cwshowSource {} {
  434.     global CODEDEBUGGER CDCLASS res
  435.     checkCwDebug
  436.     switchTo $CODEDEBUGGER
  437.     set fname [car [winNames -f]]
  438.     set ln [lindex [posToRowCol [getPos]] 0]
  439.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  440. }
  441. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"
  442.  
  443. proc cwopenHeader {} {
  444.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  445.         return [cIncludeFile $inc]
  446.     }
  447.     message "No include file found on this line!"
  448.     beep
  449. }
  450.  
  451.  
  452.